let snd_of_fst_table list = (
	let table = Hashtbl.create (List.length list) in
	List.iter (fun (s, w) -> Hashtbl.add table s w) list;
	table
);;

let fst_of_snd_table list = (
	let table = Hashtbl.create (List.length list) in
	List.iter (fun (s, w) -> Hashtbl.add table w s) list;
	table
);;

type reserved_word =
	| AND
	| ARRAY
	| BEGIN
	| CASE
	| CONST
	| DIV
	| DO
	| DOWNTO
	| ELSE
	| END
	| FOR
	| FUNCTION
	| GOTO
	| IF
	| IN
	| LABEL
	| MOD
	| NIL
	| NOT
	| OF
	| OR
	| PACKED
	| PROCEDURE
	| PROGRAM
	| RECORD
	| REPEAT
	| SET
	| THEN
	| TO
	| TYPE
	| UNTIL
	| VAR
	| WITH
	| WHILE
	| XOR;;

let reserved_word_table = [
	AND, "AND";
	ARRAY, "ARRAY";
	BEGIN, "BEGIN";
	CASE, "CASE";
	CONST, "CONST";
	DIV, "DIV";
	DO, "DO";
	DOWNTO, "DOWNTO";
	ELSE, "ELSE";
	END, "END";
	FOR, "FOR";
	FUNCTION, "FUNCTION";
	GOTO, "GOTO";
	IF, "IF";
	IN, "IN";
	LABEL, "LABEL";
	MOD, "MOD";
	NIL, "NIL";
	NOT, "NOT";
	OF, "OF";
	OR, "OR";
	PACKED, "PACKED";
	PROCEDURE, "PROCEDURE";
	PROGRAM, "PROGRAM";
	RECORD, "RECORD";
	REPEAT, "REPEAT";
	SET, "SET";
	THEN, "THEN";
	TO, "TO";
	TYPE, "TYPE";
	UNTIL, "UNTIL";
	VAR, "VAR";
	WITH, "WITH";
	WHILE, "WHILE";
	XOR, "XOR"];;

let rw_of_string_table = fst_of_snd_table reserved_word_table;;
let string_of_rw_table = snd_of_fst_table reserved_word_table;;

let is_rw (s: string): bool = (
	Hashtbl.mem rw_of_string_table s
);;

let rw_of_string (s: string): reserved_word = (
	Hashtbl.find rw_of_string_table s
);;

let string_of_rw (k: reserved_word): string = (
	Hashtbl.find string_of_rw_table k
);;

type token = 
	| Reserved of reserved_word
	| Period
	| Comma
	| Plus
	| Minus
	| Asterisk
	| Slash
	| Colon
	| Semicolon
	| Caret
	| At
	| Assign
	| NE
	| EQ
	| LT
	| LE
	| GT
	| GE
	| Range
	| Open_paren
	| Close_paren
	| Open_bracket
	| Close_bracket
	| Identifier of string
	| Integer of int
	| Real of float
	| String of string
	| Lexical_error of string
	| EOF;;

module Token = struct
	type t = token;;
	let compare = Pervasives.compare;;
	let invalid = None;;
	let eof = EOF;;
	let make_pp ~(pattern: bool) ~(quali: bool) ~(paren: bool) (f: Format.formatter) (e: t): unit = (
		let has_value = Obj.is_block (Obj.repr e) in
		if paren && has_value then (
			Format.pp_print_char f '(';
			Format.pp_print_cut f ()
		);
		Format.pp_open_box f 2;
		if quali then Format.pp_print_string f "Lexical.";
		begin match e with
		| Reserved rw ->
			Format.pp_print_string f "Reserved";
			Format.pp_print_space f ();
			if quali then Format.pp_print_string f "Lexical.";
			Format.pp_print_string f (string_of_rw rw)
		| Period ->
			Format.pp_print_string f "Period"
		| Comma ->
			Format.pp_print_string f "Comma"
		| Plus ->
			Format.pp_print_string f "Plus"
		| Minus ->
			Format.pp_print_string f "Minus"
		| Asterisk ->
			Format.pp_print_string f "Asterisk"
		| Slash ->
			Format.pp_print_string f "Slash"
		| Colon ->
			Format.pp_print_string f "Colon"
		| Semicolon ->
			Format.pp_print_string f "Semicolon"
		| Caret ->
			Format.pp_print_string f "Caret"
		| At ->
			Format.pp_print_string f "At"
		| Assign ->
			Format.pp_print_string f "Assign"
		| NE ->
			Format.pp_print_string f "NE"
		| EQ ->
			Format.pp_print_string f "EQ"
		| LT ->
			Format.pp_print_string f "LT"
		| LE ->
			Format.pp_print_string f "LE"
		| GT ->
			Format.pp_print_string f "GT"
		| GE ->
			Format.pp_print_string f "GE"
		| Range ->
			Format.pp_print_string f "Range"
		| Open_paren ->
			Format.pp_print_string f "Open_paren"
		| Close_paren ->
			Format.pp_print_string f "Close_paren"
		| Open_bracket ->
			Format.pp_print_string f "Open_bracket"
		| Close_bracket ->
			Format.pp_print_string f "Close_bracket"
		| Identifier i ->
			Format.pp_print_string f "Identifier";
			Format.pp_print_space f ();
			if pattern then (
				Format.pp_print_char f '_'
			) else (
				Format.pp_print_char f '\"';
				Format.pp_print_string f i;
				Format.pp_print_char f '\"'
			)
		| Integer x ->
			Format.pp_print_string f "Integer";
			Format.pp_print_space f ();
			if pattern then (
				Format.pp_print_char f '_'
			) else (
				if x < 0 then Format.pp_print_char f '(';
				Format.pp_print_int f x;
				if x < 0 then Format.pp_print_char f ')'
			)
		| Real x ->
			Format.pp_print_string f "Real";
			Format.pp_print_space f ();
			if pattern then (
				Format.pp_print_char f '_'
			) else (
				if x < 0.0 then Format.pp_print_char f '(';
				Format.pp_print_float f x;
				if x < 0.0 then Format.pp_print_char f ')'
			)
		| String s ->
			Format.pp_print_string f "String";
			Format.pp_print_space f ();
			if pattern then (
				Format.pp_print_char f '_'
			) else (
				Format.pp_print_char f '\"';
				Format.pp_print_string f (String.escaped s);
				Format.pp_print_char f '\"'
			)
		| Lexical_error message ->
			Format.pp_print_string f "Lexical_error";
			Format.pp_print_space f ();
			if pattern then (
				Format.pp_print_char f '_'
			) else (
				Format.pp_print_char f '\"';
				Format.pp_print_string f (String.escaped message);
				Format.pp_print_char f '\"'
			)
		| EOF ->
			Format.pp_print_string f "EOF"
		end;
		Format.pp_close_box f ();
		if paren && has_value then (
			Format.pp_print_cut f ();
			Format.pp_print_char f ')'
		)
	);;
	let pp_pattern = make_pp ~pattern:true;;
	let pp = make_pp ~pattern:false;;
	let pp_typename ~(quali: bool) ~(paren: bool) (f: Format.formatter) (_: t list): unit = (
		if quali then Format.pp_print_string f "Lexical.";
		Format.pp_print_string f "token"
	);;
end;;
